home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DELPHI32 / LISTBOX / FILE32 / FILE32.~PA < prev    next >
Text File  |  1995-12-12  |  4KB  |  146 lines
  1. unit File32;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, FileCtrl, Call32NT, LongName;
  8.  
  9. const
  10.   DefaultDir = 'c:\';
  11.   DefaultMask = '*.*';
  12.  
  13. type
  14.   ttime = array[0..1] of longint;
  15.   fd = record
  16.     dwFileAttributes:longint;
  17.     ftCreationTime,
  18.     ftLastAccessTime,
  19.     ftLastWriteTime:ttime;
  20.     nFileSizeHigh,
  21.     nFileSizeLow,
  22.     dwReserved0,
  23.     dwReserved1:longint;
  24.     cFileName:array[0..259] of char;
  25.     cAlternateFileName:array[0..13] of char;
  26.   end;
  27.   pfd = ^fd;
  28.  
  29.   TFileType = ( ftHidden , ftSystem, ftArchive, ftReadOnly );
  30.   TFileTypeSet = set of TFileType;
  31.  
  32.   TFile32ListBox = class(TListBox)
  33.   private
  34.     { Private declarations }
  35.     FDirectory : string;
  36.     FHandle:longint;
  37.     FFileType : TFileTypeSet;
  38.     FMask: string;
  39.     procedure SetDirectory(Value: string);
  40.   protected
  41.     { Protected declarations }
  42.   public
  43.     { Public declarations }
  44.     constructor Create(AOwner: TComponent); override;
  45.     procedure Update; override;
  46.   published
  47.     { Published declarations }
  48.     property Directory : string read FDirectory write SetDirectory;
  49.     property FileType : TFileTypeSet read FFileType write FFileType;
  50.     property Mask : string read FMask write FMask;
  51.   end;
  52.  
  53. procedure Register;
  54.  
  55. {Declaration of the 32 bit functions}
  56. var
  57.   W32FindFirstFile:
  58.     function(lpszSearchFile:pchar;var lpffd:fd;id:longint):longint;
  59.   W32FindNextFile:
  60.     function(hFindFile:longint;var lpffd:fd;id:longint):longbool;
  61.   W32FindClose:
  62.     function(hFindFile:longint;id:longint):Longbool;
  63.  
  64.   {Declaration of a unique identifier for each 32 bit function}
  65.   id_W32FindFirstFile,
  66.   id_W32FindNextFile,
  67.   id_W32FindClose : LongInt;
  68.   lr : fd;
  69.   localtime:ttime;
  70.   ok:longbool;
  71.   i:integer;
  72.  
  73.  
  74. implementation
  75.  
  76. constructor TFile32ListBox.Create(AOwner: TComponent);
  77. begin
  78.   inherited Create(AOwner);              {call inherited constructor}
  79.   FDirectory := DefaultDir;
  80.   FMask := DefaultMask;
  81. end;
  82.  
  83.  
  84. procedure TFile32ListBox.SetDirectory(Value: string);
  85. begin
  86.   if Value[Length(Value)] <> '\' then
  87.     FDirectory := Value + '\'
  88.   else
  89.     FDirectory := Value;
  90.   Update;
  91. end;
  92.  
  93.  
  94. procedure TFile32ListBox.Update;
  95. var
  96.   DirPtr : PChar;
  97.   tmp : string;
  98.   FAttr: LongInt;
  99. begin
  100.   tmp := FDirectory + Mask + #0;
  101.   FAttr := 0;
  102.   if ftArchive in FFileType then Inc(FAttr, 32);
  103.   if ftReadOnly in FFileType then Inc(FAttr, 1);
  104.   if ftHidden in FFileType then Inc(FAttr, 2);
  105.   if ftSystem in FFileType then Inc(FAttr, 4);
  106.   DirPtr := @tmp[1];
  107.   FHandle := W32FindFirstFile(DirPtr, lr, id_W32FindFirstFile);
  108.   Items.Clear;
  109.   if FHandle <> -1 then
  110.   repeat
  111.     if (StrComp(lr.cfilename, '.') <> 0) and
  112.        (StrComp(lr.cfilename, '..') <> 0) and
  113.        (lr.dwFileAttributes = FAttr) then
  114.       Items.Add(StrPas(lr.cfilename));
  115.     ok:=W32FindNextFile(FHandle, lr, id_W32FindNextFile);
  116.   until not ok;
  117.   W32FindClose(FHandle, id_W32FindClose);
  118. end;
  119.  
  120.  
  121. procedure Register;
  122. begin
  123.   RegisterComponents('Samples', [TFile32ListBox]);
  124. end;
  125.  
  126.  
  127. initialization
  128.   {Initialization of the 32 bit functions}
  129.   @W32FindFirstFile:=@Call32;
  130.   @W32FindNextFile:=@Call32;
  131.   @W32FindClose:=@Call32;
  132.  
  133.   id_W32FindFirstFile:=Declare32('FindFirstFile', 'kernel32', 'pp');
  134.   id_W32FindNextFile:=Declare32('FindNextFile', 'kernel32', 'ip');
  135.   id_W32FindClose:=Declare32('FindClose', 'kernel32', 'i');
  136.  
  137.   {Check if everything went well. If there was only a single error,
  138.    Call32NTError=false}
  139.   if Call32NTError then begin
  140.     ShowMessage('FileListBox: Cannot load the desired 32 bit functions!');
  141.     halt(1);
  142.   end;
  143. end.
  144.  
  145.  
  146.